home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / IQ_TEST / BARONA.PAS < prev    next >
Pascal/Delphi Source File  |  1994-08-03  |  13KB  |  502 lines
  1. Program basicmenu;
  2.  
  3. {$R basicmnu.res}
  4. {$R Wais.res}
  5.  
  6.  
  7. uses wintypes, winprocs, wobjects, sfx200, wincrt;
  8.  
  9. const
  10.      id_item1=101;
  11.      id_item2=102;
  12.      id_item4=104;
  13.      id_help=200;
  14.      id_listbox1=800;
  15.      id_listbox2=801;
  16.      id_listbox3=802;
  17.    
  18.  
  19.      helpcreate=1;
  20.      helpuse=2;
  21.  
  22. var
  23.    fsiq,psiq,vsiq:real;
  24.   
  25. type tmenuapp=object(tapplication)
  26.      procedure initmainwindow;virtual;
  27.    
  28.      end;
  29.  
  30.      pmainwin=^tmainwin;
  31.      tmainwin=object(tsfxwindow)
  32.      cmhelp:boolean;
  33.      constructor init (aparent:pwindowsobject;atitle:pchar);
  34.      procedure help (var msg:tmessage);virtual cm_first + id_help;
  35.      procedure item1 (var msg:tmessage); virtual cm_first + id_item1;
  36.      procedure item2 (var msg:tmessage); virtual cm_first + id_item2;
  37.      procedure item4 (var msg:tmessage); virtual cm_first + id_item4;
  38.      end;
  39.  
  40.      
  41.      
  42.      pinfodlg = ^tsfxdialog;
  43.      tsfxdialog = object(tdialog)
  44.                 constructor init (aparent:pwindowsobject; aname:pchar;buffer:pchar);
  45.                 procedure setupwindow;virtual;
  46.                 procedure ok (var msg:tmessage);virtual id_first + id_ok;
  47.                 end;
  48.  
  49.      pgenderdlg = ^tgenderdlg;
  50.      tgenderdlg = object(tdialog)
  51.                   constructor init (aparent:pwindowsobject; atitle:pchar);
  52.                   procedure ok (var msg:tmessage);virtual id_first + id_ok;
  53.                   end;
  54.  
  55.      pagedlg = ^tagedlg;
  56.      tagedlg = object(tdialog)
  57.                   constructor init (aparent:pwindowsobject; atitle:pchar);
  58.                   procedure ok (var msg:tmessage);virtual id_first + id_ok;
  59.                   end;
  60.  
  61.      
  62.      pracedlg = ^tracedlg;
  63.      tracedlg = object(tdialog)
  64.                   constructor init (aparent:pwindowsobject; atitle:pchar);
  65.                   procedure ok (var msg:tmessage);virtual id_first + id_ok;
  66.                   end;
  67.  
  68.  
  69.      peducdlg = ^teducdlg;
  70.      teducdlg = object(tdialog)
  71.                   constructor init (aparent:pwindowsobject; atitle:pchar);
  72.                   procedure ok (var msg:tmessage);virtual id_first + id_ok;
  73.                   end;
  74.  
  75.      pworkdlg = ^tworkdlg;
  76.      tworkdlg = object(tdialog)
  77.                   constructor init (aparent:pwindowsobject; atitle:pchar);
  78.                   procedure ok (var msg:tmessage);virtual id_first + id_ok;
  79.                   end;
  80.  
  81.      pregiondlg = ^tregiondlg;
  82.      tregiondlg = object(tdialog)
  83.                   constructor init (aparent:pwindowsobject; atitle:pchar);
  84.                   procedure ok (var msg:tmessage);virtual id_first + id_ok;
  85.                   end;
  86.  
  87.      
  88.      presdlg = ^tresdlg;
  89.      tresdlg = object(tdialog)
  90.                   constructor init (aparent:pwindowsobject; atitle:pchar);
  91.                   procedure ok (var msg:tmessage);virtual id_first + id_ok;
  92.                   end;
  93.  
  94.      piqdlg = ^tiqdlg;
  95.      tiqdlg = object(tdialog)
  96.               listbox1:plistbox;
  97.               listbox2:plistbox;
  98.               listbox3:plistbox;
  99.               constructor init (aparent:pwindowsobject; atitle:pchar);
  100.               procedure setupwindow;virtual;
  101.               procedure ok (var msg:tmessage);virtual id_first + id_ok;
  102.               end;
  103.  
  104.      pwarndlg = ^twarndlg;
  105.      twarndlg = object(tdialog)
  106.                   constructor init (aparent:pwindowsobject; atitle:pchar);
  107.                   procedure ok (var msg:tmessage);virtual id_first + id_ok;
  108.                   end;
  109. {*******************    ABOUT DIALOG    *************************************}
  110.  
  111. constructor tsfxdialog.init (aparent:pwindowsobject; aname:pchar;buffer:pchar);
  112.  
  113. begin
  114.      attr.param:=mws_raised3dFrame;
  115.      tdialog.init(aparent,aname);
  116. end;
  117.  
  118. procedure tsfxdialog.setupwindow;
  119. begin
  120.      attr.param:=mws_raised3dframe;
  121.      tdialog.setupwindow;
  122. end;
  123.  
  124.  
  125. procedure tsfxdialog.ok (var msg:tmessage);
  126. begin
  127.      tdialog.ok(msg);
  128. end;
  129.  
  130.  
  131. constructor tgenderdlg.init (aparent:pwindowsobject; atitle:pchar);
  132. var
  133.    btn:pradiobutton;
  134.  
  135. begin
  136.      attr.param:=mws_raised3dFrame;
  137.      tdialog.init(aparent,atitle);
  138.      new(btn,initresource(@self,200));
  139.      new(btn,initresource(@self,201));
  140. end;
  141.  
  142.  
  143. procedure tgenderdlg.ok (var msg:tmessage);
  144. begin
  145.      tdialog.ok(msg);
  146. end;
  147.  
  148.  
  149. constructor tagedlg.init (aparent:pwindowsobject; atitle:pchar);
  150. var
  151.    btn:pradiobutton;
  152.  
  153. begin
  154.      attr.param:=mws_raised3dFrame;
  155.      tdialog.init(aparent,atitle);
  156.      new(btn,initresource(@self,203));
  157.      new(btn,initresource(@self,204));
  158.      new(btn,initresource(@self,205));
  159.      new(btn,initresource(@self,206));
  160.      new(btn,initresource(@self,207));
  161.      new(btn,initresource(@self,208));
  162.      new(btn,initresource(@self,209));
  163.      new(btn,initresource(@self,210));
  164.      new(btn,initresource(@self,211));
  165. end;
  166.  
  167.  
  168. procedure tagedlg.ok (var msg:tmessage);
  169. begin
  170.      tdialog.ok(msg);
  171. end;
  172.  
  173.  
  174. constructor tracedlg.init (aparent:pwindowsobject; atitle:pchar);
  175. var
  176.    btn:pradiobutton;
  177.  
  178. begin
  179.      attr.param:=mws_raised3dFrame;
  180.      tdialog.init(aparent,atitle);
  181.      new(btn,initresource(@self,212));
  182.      new(btn,initresource(@self,213));
  183.      new(btn,initresource(@self,214));
  184. end;
  185.  
  186.  
  187. procedure tracedlg.ok (var msg:tmessage);
  188. begin
  189.      tdialog.ok(msg);
  190. end;
  191.  
  192.  
  193. constructor teducdlg.init (aparent:pwindowsobject; atitle:pchar);
  194. var
  195.    btn:pradiobutton;
  196.  
  197. begin
  198.      attr.param:=mws_raised3dFrame;
  199.      tdialog.init(aparent,atitle);
  200.      new(btn,initresource(@self,101));
  201.      new(btn,initresource(@self,102));
  202.      new(btn,initresource(@self,103));
  203.      new(btn,initresource(@self,104));
  204.      new(btn,initresource(@self,105));
  205.      new(btn,initresource(@self,106));
  206. end;
  207.  
  208.  
  209. procedure teducdlg.ok (var msg:tmessage);
  210. begin
  211.      tdialog.ok(msg);
  212. end;
  213.  
  214. constructor tworkdlg.init (aparent:pwindowsobject; atitle:pchar);
  215. var
  216.    btn:pradiobutton;
  217.  
  218. begin
  219.      attr.param:=mws_raised3dFrame;
  220.      tdialog.init(aparent,atitle);
  221.      new(btn,initresource(@self,101));
  222.      new(btn,initresource(@self,102));
  223.      new(btn,initresource(@self,103));
  224.      new(btn,initresource(@self,104));
  225.      new(btn,initresource(@self,105));
  226.      new(btn,initresource(@self,106));
  227. end;
  228.  
  229.  
  230. procedure tworkdlg.ok (var msg:tmessage);
  231. begin
  232.      tdialog.ok(msg);
  233. end;
  234.  
  235.  
  236. constructor tregiondlg.init (aparent:pwindowsobject; atitle:pchar);
  237. var
  238.    btn:pradiobutton;
  239.  
  240. begin
  241.      attr.param:=mws_raised3dFrame;
  242.      tdialog.init(aparent,atitle);
  243.      new(btn,initresource(@self,101));
  244.      new(btn,initresource(@self,102));
  245.      new(btn,initresource(@self,103));
  246.      new(btn,initresource(@self,104));
  247. end;
  248.  
  249.  
  250. procedure tregiondlg.ok (var msg:tmessage);
  251. begin
  252.      tdialog.ok(msg);
  253. end;
  254.  
  255.  
  256. constructor tresdlg.init (aparent:pwindowsobject; atitle:pchar);
  257. var
  258.    btn:pradiobutton;
  259.  
  260. begin
  261.      attr.param:=mws_raised3dFrame;
  262.      tdialog.init(aparent,atitle);
  263.      new(btn,initresource(@self,101));
  264.      new(btn,initresource(@self,102));
  265. end;
  266.  
  267.  
  268. procedure tresdlg.ok (var msg:tmessage);
  269. begin
  270.      tdialog.ok(msg);
  271. end;
  272.  
  273.  
  274. constructor tiqdlg.init (aparent:pwindowsobject; atitle:pchar);
  275. begin
  276.      attr.param:=mws_raised3dFrame;
  277.      tdialog.init(aparent,atitle);
  278.      listbox1:=new(plistbox,initresource(@self,id_listbox1));
  279.      listbox2:=new(plistbox,initresource(@self,id_listbox2));
  280.      listbox3:=new(plistbox,initresource(@self,id_listbox3));
  281. end;
  282.  
  283. procedure tiqdlg.setupwindow;
  284. var
  285.      full:string;
  286.      perf:string;
  287.      verb:string;
  288.      myfull:string;
  289.      myverb:string;
  290.      myperf:string;
  291.  
  292. begin
  293.      tdialog.setupwindow;
  294.  
  295.      STR(psiq:3:0,perf);
  296.      myperf:=perf;
  297.      perf:=' '+myperf+'                      ';
  298.      STR(fsiq:3:0,full);
  299.      myfull:=full;
  300.      full:=' '+myfull+'                      ';
  301.      STR(vsiq:3:0,verb);
  302.      myverb:=verb;
  303.      verb:=' '+myverb+'                      ';
  304.      listbox1^.addstring (@verb[1]);
  305.      listbox2^.addstring (@perf[1]);
  306.      listbox3^.addstring (@full[1]);
  307. end;
  308.      
  309. procedure tiqdlg.ok (var msg:tmessage);
  310. begin
  311.      tdialog.ok(msg);
  312. end;
  313.  
  314.  
  315. constructor twarndlg.init (aparent:pwindowsobject; atitle:pchar);
  316. begin
  317.      attr.param:=mws_raised3dFrame;
  318.      tdialog.init(aparent,atitle);
  319. end;
  320.  
  321.  
  322. procedure twarndlg.ok (var msg:tmessage);
  323. begin
  324.      tdialog.ok(msg);
  325. end;
  326.  
  327. {********************** Data Collecting Dialogs *****************************}
  328.  
  329.  
  330. {*******************    MENU ITEM PROCEDURES    ****************************}
  331.  
  332. procedure tmainwin.item1 (var msg:tmessage);
  333. var
  334.    dlg1:pgenderdlg;
  335.    dlg2:pagedlg;
  336.    dlg3:pracedlg;
  337.    dlg4:peducdlg;
  338.    dlg5:pworkdlg;
  339.    dlg6:pregiondlg;
  340.    dlg7:presdlg;
  341.    dlg99:piqdlg;
  342.    dlg100:pwarndlg;
  343.    btns:array[0..8]of word;
  344.    gender,age,race,educ,work,region,res,x:integer;
  345.       
  346. begin
  347.      new(dlg1,init(@self,pchar('DIALOG_1')));
  348.      dlg1^.transferbuffer:=@btns;
  349.      application^.execdialog(dlg1);
  350.      if btns[0]=1 then gender:=2 else
  351.      if btns[1]=1 then gender:=1 else
  352.      gender:=0;
  353.      for x:=0 to 8 do
  354.      btns[x]:=0;
  355.      new(dlg2,init(@self,pchar('DIALOG_2')));
  356.      dlg2^.transferbuffer:=@btns;
  357.      application^.execdialog(dlg2);
  358.      if btns[0]=1 then age:=1 else
  359.      if btns[1]=1 then age:=2 else
  360.      if btns[2]=1 then age:=3 else
  361.      if btns[3]=1 then age:=4 else
  362.      if btns[4]=1 then age:=5 else
  363.      if btns[5]=1 then age:=6 else
  364.      if btns[6]=1 then age:=7 else
  365.      if btns[7]=1 then age:=8 else
  366.      if btns[8]=1 then age:=9 else
  367.      age:=0;
  368.      for x:=0 to 8 do
  369.      btns[x]:=0;
  370.      new(dlg3,init(@self,pchar('DIALOG_3')));
  371.      dlg3^.transferbuffer:=@btns;
  372.      application^.execdialog(dlg3);
  373.      if btns[0]=1 then race:=1 else
  374.      if btns[1]=1 then race:=2 else
  375.      if btns[2]=1 then race:=3 else
  376.      race:=0;
  377.      for x:=0 to 8 do
  378.      btns[x]:=0;
  379.      new(dlg4,init(@self,pchar('DIALOG_4')));
  380.      dlg4^.transferbuffer:=@btns;
  381.      application^.execdialog(dlg4);
  382.      if btns[0]=1 then educ:=1 else
  383.      if btns[1]=1 then educ:=2 else
  384.      if btns[2]=1 then educ:=3 else
  385.      if btns[3]=1 then educ:=4 else
  386.      if btns[4]=1 then educ:=5 else
  387.      if btns[5]=1 then educ:=6 else
  388.      educ:=0;
  389.      for x:=0 to 8 do
  390.      btns[x]:=0;
  391.      new(dlg5,init(@self,pchar('DIALOG_5')));
  392.      dlg5^.transferbuffer:=@btns;
  393.      application^.execdialog(dlg5);
  394.      if btns[0]=1 then work:=6 else
  395.      if btns[1]=1 then work:=5 else
  396.      if btns[2]=1 then work:=4 else
  397.      if btns[3]=1 then work:=3 else
  398.      if btns[4]=1 then work:=2 else
  399.      if btns[5]=1 then work:=1 else
  400.      work:=0;
  401.      for x:=0 to 8 do
  402.      btns[x]:=0;
  403.      new(dlg6,init(@self,pchar('DIALOG_6')));
  404.      dlg6^.transferbuffer:=@btns;
  405.      application^.execdialog(dlg6);
  406.      if btns[0]=1 then region:=1 else
  407.      if btns[1]=1 then region:=2 else
  408.      if btns[2]=1 then region:=3 else
  409.      if btns[3]=1 then region:=4 else
  410.      region:=0; 
  411.      for x:=0 to 8 do
  412.      btns[x]:=0;
  413.      new(dlg7,init(@self,pchar('DIALOG_7')));
  414.      dlg7^.transferbuffer:=@btns;
  415.      application^.execdialog(dlg7);
  416.      if btns[0]=1 then res:=2 else
  417.      if btns[1]=1 then res:=1 else
  418.      res:=0;
  419.      for x:=0 to 8 do
  420.      btns[x]:=0;
  421.      fsiq:=0;
  422.      psiq:=0;
  423.      vsiq:=0;
  424.      fsiq:=54.96+(0.47*age) + (1.76*gender) + (4.71*race) + (5.02*educ) + ( 1.89*work) +
  425.            (0.59*region);
  426.      vsiq:=54.23+(0.49*age) + (1.92*gender) + (4.24*race) + (5.25*educ) + ( 1.89*work) +
  427.            (1.24*res);
  428.      psiq:=61.58+(0.31*age) + (1.09*gender) + (4.95*race) + (3.75*educ) + ( 1.54*work) +
  429.            (0.82*region);
  430.      if (age>0) and (gender>0) and (race>0) and (educ>0) and (work>0) and
  431.         (region>0) and (res>0) then
  432.      begin
  433.      new(dlg99,init(@self,pchar('DIALOG_99')));
  434.      application^.execdialog(dlg99);
  435.      end
  436.      else
  437.      begin
  438.      new(dlg100,init(@self,pchar('warning')));
  439.      application^.execdialog(dlg100);
  440.      end;
  441.  
  442.  
  443.  
  444.  
  445. end;
  446.  
  447. procedure tmainwin.item2 (var msg:tmessage);
  448. begin
  449.      if 
  450.      sfxmsgbox (hwindow,'Are you sure you want to END?', 'Terminate Program?',mb_iconquestion
  451.      or mb_gostop,0)=id_go
  452.      then
  453.      closewindow
  454.      else
  455.  
  456.  
  457. end;
  458. procedure tmainwin.item4 (var msg:tmessage);
  459. var
  460.    buffer:array[0..30]of char;
  461.    dialog:pinfodlg;
  462. begin
  463.      dialog:=new(pinfodlg,init(@self,'aboutdlg',buffer));
  464.      application^.execdialog(dialog);
  465.      
  466. end;
  467.  
  468. procedure tmainwin.help (var msg:tmessage);
  469. begin
  470.      winhelp (hwindow,'barona.HLP',help_index,0);
  471. end;
  472.  
  473.  
  474. {*******************    MAIN WINDOW INITS       ****************************}
  475.  
  476. constructor tmainwin.init (aparent:pwindowsobject; atitle:pchar);
  477. begin
  478.      tsfxwindow.init (aparent,atitle);
  479.      cmhelp:=false;
  480.      attr.menu:=loadmenu(hinstance, 'menu_1');
  481.     
  482. end;
  483.  
  484. procedure tmenuapp.initmainwindow;
  485. begin
  486.      mainwindow:=new(pmainwin, init (nil, 'BARONA REGRESSION ESTIMATED IQ VERSION 1.1'));
  487.  
  488. end;
  489.  
  490.  
  491. {*******************    MAIN PROGRAM            ****************************}
  492.  
  493.  
  494. var menuapp:tmenuapp;
  495.  
  496. begin
  497.      menuapp.init('menu demo');
  498.      menuapp.run;
  499.      menuapp.done;
  500. end.
  501.  
  502.